home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 015 / sfutil.arc / MAKELAND.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-09-22  |  16.3 KB  |  747 lines
  1. Program MakeBold;
  2.  
  3. {$B+}
  4. {$V-}
  5.  
  6. const
  7.    MaxChar = 255;
  8.  
  9. type
  10.    DoubIntg = array[1..2] of Integer;
  11.    String80 = String[80];
  12.    tRegs = record case boolean of
  13.             false: (Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags: Integer);
  14.             true:  (Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh: Byte);
  15.             end;
  16.  
  17.    tFontHdr = record
  18.                   C26:        Integer;
  19.                   CNull1:     Byte;
  20.                   FontType:   Byte;
  21.                   CNull2:     Integer;
  22.                   BaseLine:   Integer;
  23.                   Width:      Integer;
  24.                   Height:     Integer;
  25.                   Orient:     Byte;
  26.                   Fixed:      Byte;
  27.                   SymSet:     Integer;
  28.                   Pitch:      Integer;
  29.                   Points:     Integer;
  30.                   CNull3:     Integer;
  31.                   CNull4:     Byte;
  32.                   Style:      Byte;
  33.                   Weight:     Byte;
  34.                   TypeFace:   Byte;
  35.                   end;
  36.  
  37.    tCharHdr = record
  38.                   C4:         Byte;
  39.                   CNull1:     Byte;
  40.                   C14:        Byte;
  41.                   C1:         Byte;
  42.                   Orient:     Byte;
  43.                   CNull2:     Byte;
  44.                   LeftOffset: Integer;
  45.                   TopOffset:  Integer;
  46.                   CWidth:     Integer;
  47.                   CHeight:    Integer;
  48.                   DeltaX:     Integer;
  49.                   end;
  50.  
  51.    tCRow = array[0..63] of byte;
  52.    tChar = array[0..255] of tCRow;
  53.  
  54.    tBits = array[0..32767] of byte;
  55.    tpBits = ^tBits;
  56.  
  57.    tCharEnt =  record
  58.                   ChNbr:      Byte;
  59.                   Orient:     Byte;
  60.                   LeftOffset: Integer;
  61.                   TopOffset:  Integer;
  62.                   CWidth:     Integer;
  63.                   CHeight:    Integer;
  64.                   DeltaX:     Integer;
  65.                   CharLen:    Integer;
  66.                   CharPtr:    tpBits;
  67.                   end;
  68.    tFont =  record
  69.                FontType:   Byte;
  70.                BaseLine:   Integer;
  71.                Width:      Integer;
  72.                Height:     Integer;
  73.                Orient:     Byte;
  74.                Fixed:      Byte;
  75.                SymSet:     Integer;
  76.                Pitch:      Integer;
  77.                Points:     Integer;
  78.                Style:      Byte;
  79.                Weight:     Byte;
  80.                TypeFace:   Byte;
  81.                Chars:      array[0..MaxChar] of tCharEnt;
  82.                end;
  83.    tpFont = ^tFont;
  84.  
  85.    tFName = String[40];
  86.  
  87.    tMasks = array[0..7] of byte;
  88.  
  89. const
  90.    DefRegs: tRegs = (Ax:0;Bx:0;Cx:0;Dx:0;Bp:0;Si:0;Di:0;Ds:0;Es:0;Flags:0);
  91.    Masks: tMasks = ($80,$40,$20,$10,8,4,2,1);
  92.  
  93. var
  94.    FFile:      Integer;
  95.    FFName:     tFName;
  96.    FLen:       DoubIntg;
  97.    FPos:       DoubIntg;
  98.  
  99.    Font:       tpFont;
  100.  
  101.    MinCn:      Byte;
  102.    MaxCn:      Byte;
  103.  
  104.    ChBits:     tChar;
  105.    LChBits:    tChar;
  106.  
  107.    Ch:         Char;
  108.  
  109. function GEDoubIntg(
  110.        V1:     DoubIntg;
  111.        V2:     DoubIntg): Boolean;
  112.  
  113.    var
  114.       Result: Boolean;
  115.  
  116.    begin {GEDoubIntg}
  117.  
  118.    if v1[1]>v2[1] then
  119.       Result:=true
  120.    else if v1[1]<v2[1] then
  121.       Result:=false
  122.    else if (v1[2]<0) and (v2[2]>=0) then
  123.       Result:=true
  124.    else if (v1[2]>=0) and (v2[2]<0) then
  125.       Result:=false
  126.    else
  127.       Result:= V1[2]>=V2[2];
  128.  
  129.    GEDoubIntg:=Result;
  130.  
  131.    end {GEDoubIntg};
  132.  
  133. procedure AddDoubIntg(
  134.    var V:      DoubIntg;
  135.        Offset: Integer);
  136.  
  137.    var
  138.       P1:   Integer;
  139.       P2:   Integer;
  140.  
  141.    begin {AddDoubIntg}
  142.  
  143.    P1:=V[2] and $FF;
  144.    P2:=V[2] shr 8;
  145.  
  146.    P1:=P1+Offset;
  147.  
  148.    P2:=P2+ (P1 shr 8);
  149.    P1:=P1 and $FF;
  150.  
  151.    V[1]:=V[1] + (P2 shr 8);
  152.    P2:=P2 and $FF;
  153.    V[2]:=(P2 shl 8) + P1;
  154.  
  155.    end {AddDoubIntg};
  156.  
  157. procedure CloseFont(
  158.    var FNbr:      Integer);
  159.  
  160.    var
  161.       Regs: tRegs;
  162.  
  163.    begin {CloseFont}
  164.  
  165.    if FNbr<>0 then
  166.       begin
  167.       Regs:=DefRegs;
  168.       Regs.Ah:=$3E;
  169.       Regs.Bx:=FNbr;
  170.       MsDos(Regs);
  171.       end;
  172.  
  173.    FNbr:=0;
  174.  
  175.    end {CloseFont};
  176.  
  177. procedure OpenFont(
  178.        Create:    Boolean;
  179.        Name:      tFName;
  180.    var FNbr:      Integer;
  181.    var FLen:      DoubIntg;
  182.    var Error:     Integer);
  183.  
  184.    var
  185.       Regs: tRegs;
  186.  
  187.    begin {OpenFont}
  188.  
  189.    Error:=0;
  190.  
  191.    if FNbr<>0 then
  192.       CloseFont(FNbr);
  193.  
  194.    Name[ord(Name[0])+1]:=#0;
  195.    Regs:=DefRegs;
  196.    if Create then
  197.       begin
  198.       Regs.Ax:=$3C00;
  199.       Regs.Cx:=32;
  200.       end
  201.    else
  202.       Regs.Ax:=$3D00;
  203.    Regs.Ds:=Seg(Name[1]);
  204.    Regs.Dx:=Ofs(Name[1]);
  205.    MsDos(Regs);
  206.    if odd(Regs.Flags) then
  207.       begin
  208.       Error:=Regs.Ax;
  209.       Regs.Ax:=0;
  210.       end;
  211.    FNbr:=Regs.Ax;
  212.  
  213.    if not Create and (Error=0) then
  214.       begin
  215.       Regs.Ah:=$42;
  216.       Regs.Al:=2;
  217.       Regs.Bx:=FNbr;
  218.       Regs.Cx:=0;
  219.       Regs.Dx:=0;
  220.       MsDos(Regs);
  221.       FLen[1]:=Regs.Dx;
  222.       FLen[2]:=Regs.Ax;
  223.       end;
  224.  
  225.  
  226.    end {OpenFont};
  227.  
  228. procedure MoveFromFont(
  229.        Nbr:          Integer;
  230.        FirstByte:    DoubIntg;
  231.    var Dest;
  232.        Len:          Integer);
  233.  
  234.    var
  235.       Regs:  tRegs;
  236.  
  237.    begin {MoveFromFont}
  238.  
  239.    Regs:=DefRegs;
  240.    with Regs do
  241.       begin
  242.       Ax:=$4200;
  243.       Bx:=Nbr;
  244.       Cx:=FirstByte[1];
  245.       Dx:=FirstByte[2];
  246.       end;
  247.    MsDos(Regs);
  248.  
  249.    Regs:=DefRegs;
  250.    with Regs do
  251.       begin
  252.       Ax:=$3F00;
  253.       Bx:=Nbr;
  254.       Cx:=Len;
  255.       Dx:=Ofs(Dest);
  256.       Ds:=Seg(Dest);
  257.       end;
  258.    MsDos(Regs);
  259.  
  260.    end {MoveFromFont};
  261.  
  262. procedure MoveToFont(
  263.        Nbr:          Integer;
  264.    var Src;
  265.        Len:          Integer);
  266.  
  267.    var
  268.       Regs:  tRegs;
  269.  
  270.    begin {MoveToFont}
  271.  
  272.    Regs:=DefRegs;
  273.    with Regs do
  274.       begin
  275.       Ax:=$4000;
  276.       Bx:=Nbr;
  277.       Cx:=Len;
  278.       Dx:=Ofs(Src);
  279.       Ds:=Seg(Src);
  280.       end;
  281.    MsDos(Regs);
  282.  
  283.    end {MoveToFont};
  284.  
  285. procedure GetFontNameAndOpen(
  286.        LabelStr:     String80;
  287.        Create:       Boolean;
  288.    var FontName:     tFName;
  289.    var FontFile:     Integer;
  290.    var FLen:         DoubIntg);
  291.  
  292.    var
  293.       IoStatus: Integer;
  294.       DumbFile: File;
  295.  
  296.    begin {GetFontNameAndOpen}
  297.  
  298.    repeat
  299.       FontFile:=0;
  300.       FontName:='';
  301.       write(trm,LabelStr);
  302.       readln(trm,fontname);
  303.       if length(fontname)>0 then
  304.          begin
  305.          if Create then
  306.             begin
  307.             Assign(DumbFile,FontName);
  308.       {$I-} Erase(DumbFile);  {$I+}
  309.             IoStatus:=IoResult;
  310.             end;
  311.          OpenFont(create,FontName,FontFile,FLen,IoStatus);
  312.          if iostatus<>0 then
  313.             begin
  314.             writeln(trm,^G'Open Error ',IoStatus:1);
  315.             read(kbd,ch);
  316.             if (Ch=^C) then
  317.                Halt;
  318.             end;
  319.          end
  320.       else
  321.          write(trm,^G);
  322.  
  323.    until IoStatus=0;
  324.  
  325.    end {GetFontNameAndOpen};
  326.  
  327. procedure GetNumber(
  328.    var Num:    Integer;
  329.    var Ch:     Char);
  330.  
  331.    begin
  332.  
  333.    num:=0;
  334.    repeat
  335.       MoveFromFont(FFile,fpos,ch,1);
  336.       if (Ch>='0') and (Ch<='9') then
  337.          begin
  338.          num:=10*num+(ord(ch)-48);
  339.          adddoubintg(fpos,1);
  340.          end;
  341.    until (Ch<'0') or (Ch>'9');
  342.  
  343.    end;
  344.  
  345. procedure GetFontHeader(
  346.    var FontHdr:   tFontHdr);
  347.  
  348.    var
  349.       Str:  String[3];
  350.       Num:  Integer;
  351.       Ch:   Char;
  352.  
  353.    begin
  354.  
  355.    MoveFromFont(FFile,fpos,str[1],3);
  356.    str[0]:=#3;
  357.    if str=^[')s' then
  358.       begin
  359.       AddDoubIntg(FPos,3);
  360.       GetNumber(Num,Ch);
  361.       AddDoubIntg(FPos,1);
  362.       MoveFromFont(FFile,FPos,FontHdr,26);
  363.       AddDoubIntg(FPos,Num);
  364.       end;
  365.  
  366.    end;
  367.  
  368. procedure GetCharId(
  369.    var Cn:  Byte);
  370.  
  371.    var
  372.       Str:  String[3];
  373.       Ch:   Char;
  374.       Num:  Integer;
  375.  
  376.    begin
  377.  
  378.    MoveFromFont(FFile,fpos,str[1],3);
  379.    str[0]:=#3;
  380.    if str=^['*c' then
  381.       begin
  382.       AddDoubIntg(FPos,3);
  383.       GetNumber(Num,Ch);
  384.       Cn:=Num;
  385.       AddDoubIntg(FPos,1);
  386.       end;
  387.  
  388.    end;
  389.  
  390. procedure GetCharDef(
  391.    var CharHdr:   tCharHdr;
  392.    var CharLen:   Integer);
  393.  
  394.    var
  395.       Str:  String[3];
  396.       Ch:   Char;
  397.       Num:  Integer;
  398.  
  399.    begin
  400.  
  401.    MoveFromFont(FFile,fpos,str[1],3);
  402.    str[0]:=#3;
  403.    if str=^['(s' then
  404.       begin
  405.       AddDoubIntg(FPos,3);
  406.       GetNumber(Num,Ch);
  407.       AddDoubIntg(FPos,1);
  408.       MoveFromFont(FFile,fpos,charhdr,16);
  409.       CharLen:=Num-16;
  410.       AddDoubIntg(FPos,16);
  411.       end;
  412.  
  413.    end;
  414.  
  415. procedure ReadFont;
  416.  
  417.    var
  418.       Ch:         Char;
  419.       Cn:         Byte;
  420.       FontHdr:    tFontHdr;
  421.       CharHdr:    tCharHdr;
  422.       RowWidth:   Integer;
  423.       CharSize0:  Integer;
  424.       CharSize:   Integer;
  425.       Ix:         Integer;
  426.       X:          Byte;
  427.  
  428.    begin {ReadFont}
  429.  
  430.    for cn:=0 to maxchar do
  431.       Font^.Chars[Cn].ChNbr:=0;
  432.  
  433.    GetFontNameAndOpen('Read Font: ',false,Ffname,FFile,FLen);
  434.    FPos[1]:=0;
  435.    FPos[2]:=0;
  436.  
  437.    if FFile>0 then
  438.       begin
  439.       GetFontHeader(FontHdr);
  440.       Font^.FontType:=FontHdr.FontType;
  441.       Font^.BaseLine:=swap(FontHdr.BaseLine);
  442.       Font^.Width:=swap(FontHdr.Width);
  443.       Font^.Height:=swap(FontHdr.Height);
  444.       Font^.Orient:=FontHdr.Orient;
  445.       Font^.Fixed:=FontHdr.Fixed;
  446.       Font^.SymSet:=swap(FontHdr.SymSet);
  447.       Font^.Pitch:=swap(FontHdr.Pitch);
  448.       Font^.Points:=swap(FontHdr.Points);
  449.       Font^.Style:=FontHdr.Style;
  450.       Font^.Weight:=FontHdr.Weight;
  451.       Font^.TypeFace:=FontHdr.TypeFace;
  452.  
  453.       mincn:=255;
  454.       maxcn:=0;
  455.  
  456.       while not GEDoubIntg(FPos,FLen) do
  457.          begin
  458.          GetCharId(Cn);
  459.          GetCharDef(CharHdr,CharSize0);
  460.          if cn<mincn then
  461.             mincn:=cn;
  462.          if cn>maxcn then
  463.             maxcn:=cn;
  464.          write(trm,^M^['K',cn:1);
  465.          with Font^.Chars[cn] do
  466.             begin
  467.             ChNbr:=Cn;
  468.             Orient:=CharHdr.Orient;
  469.             LeftOffset:=swap(CharHdr.LeftOffset);
  470.             TopOffset:=swap(CharHdr.TopOffset);
  471.             CWidth:=swap(CharHdr.CWidth);
  472.             CHeight:=swap(CharHdr.CHeight);
  473.             DeltaX:=swap(CharHdr.DeltaX) div 4;
  474.             RowWidth:=(CWidth+7) shr 3; {width in bytes}
  475.             CharSize:=RowWidth*CHeight;
  476.             CharLen:=CharSize;
  477.             GetMem(CharPtr,CharSize);
  478.             MoveFromFont(FFile,FPos,CharPtr^,CharSize);
  479.             AddDoubIntg(FPos,CharSize);
  480.             end;
  481.          X:=0;
  482.          while (X=0) and not GEDoubIntg(FPos,FLen) do
  483.             begin
  484.             MoveFromFont(FFile,FPos,X,1);
  485.             if X=0 then
  486.                AddDoubIntg(FPos,1);
  487.             end;
  488.          end;
  489.  
  490.       CloseFont(FFile);
  491.       end;
  492.    writeln(trm);
  493.  
  494.    end {ReadFont};
  495.  
  496. procedure WriteFont;
  497.  
  498.    var
  499.       Ch:         Char;
  500.       Cn:         Byte;
  501.       R:          Byte;
  502.       NChars:     Byte;
  503.       WFName:     tFName;
  504.       FFile:      Integer;
  505.       IoStatus:   Integer;
  506.       ErrStr:     String[5];
  507.       NumStr:     String[5];
  508.       WString:    String80;
  509.       FLen:       DoubIntg;
  510.       FPos:       DoubIntg;
  511.       FontHdr:    tFontHdr;
  512.       CharHdr:    tCharHdr;
  513.       Regs:       tRegs;
  514.  
  515.    begin {WriteFont}
  516.  
  517.    GetFontNameAndOpen('Write Font: ',true,WFName,FFile,FLen);
  518.  
  519.    if FFile>0 then
  520.       begin
  521.       FontHdr.C26:=64 shl 8;
  522.       FontHdr.CNull1:=0;
  523.       FontHdr.CNull2:=0;
  524.       FontHdr.CNull3:=0;
  525.       FontHdr.CNull4:=0;
  526.  
  527.       FontHdr.FontType:=Font^.FontType;
  528.       FontHdr.BaseLine:=swap(Font^.BaseLine);
  529.       FontHdr.Width:=swap(Font^.Width);
  530.       FontHdr.Height:=swap(Font^.Height);
  531.       FontHdr.Orient:=Font^.Orient;
  532.       FontHdr.Fixed:=Font^.Fixed;
  533.       FontHdr.SymSet:=swap(Font^.SymSet);
  534.       FontHdr.Pitch:=swap(Font^.Pitch);
  535.       FontHdr.Points:=swap(Font^.Points);
  536.       FontHdr.Style:=Font^.Style;
  537.       FontHdr.Weight:=Font^.Weight;
  538.       FontHdr.TypeFace:=Font^.TypeFace;
  539.  
  540.       Str(sizeof(tFontHdr):1,NumStr);
  541.       WString:=^[')s'+NumStr+'W';
  542.       MoveToFont(FFile,WString[1],ord(WString[0]));
  543.       MoveToFont(FFile,FontHdr,sizeof(tFontHdr));
  544.  
  545.       for Cn:=0 to MaxChar do
  546.          if Font^.Chars[Cn].ChNbr<>0 then with Font^.Chars[Cn] do
  547.             begin
  548.             CharHdr.C4:=4;
  549.             CharHdr.CNull1:=0;
  550.             CharHdr.C14:=14;
  551.             CharHdr.C1:=1;
  552.             CharHdr.CNull2:=0;
  553.  
  554.             CharHdr.Orient:=Orient;
  555.             CharHdr.LeftOffset:=swap(LeftOffset);
  556.             CharHdr.TopOffset:=swap(TopOffset);
  557.             CharHdr.CWidth:=swap(CWidth);
  558.             CharHdr.CHeight:=swap(CHeight);
  559.             CharHdr.DeltaX:=swap(4*DeltaX);
  560.  
  561.             write(trm,^M^['K',Cn:1);
  562.             Str(Font^.Chars[Cn].ChNbr:1,NumStr);
  563.             WString:=^['*c'+NumStr+'E';
  564.             MoveToFont(FFile,WString[1],ord(Wstring[0]));
  565.  
  566.             Str((sizeof(tCharHdr)+CharLen):1,NumStr);
  567.             WString:=^['(s'+NumStr+'W';
  568.             MoveToFont(FFile,WString[1],ord(Wstring[0]));
  569.  
  570.             MoveToFont(FFile,CharHdr,sizeof(tCharHdr));
  571.             MoveToFont(FFile,CharPtr^,CharLen);
  572.  
  573.             end;
  574.  
  575.       CloseFont(FFile);
  576.       end;
  577.    writeln(trm);
  578.  
  579.  
  580.    end {WriteFont};
  581.  
  582. procedure RotateChar(
  583.    var CharEnt:   tCharEnt);
  584.  
  585.    var
  586.       NCI:        Byte;
  587.       NBW:        Byte;
  588.       NRI:        Byte;
  589.       NCO:        Byte;
  590.       NBWO:       Byte;
  591.       NRO:        Byte;
  592.       Byt:        Byte;
  593.       EC:         Byte;
  594.       ER:         Byte;
  595.       CR:         Byte;
  596.       CRB:        Byte;
  597.       CC:         Byte;
  598.       BC:         Byte;
  599.       ColBytes:   Integer;
  600.       COff:       Integer;
  601.  
  602.    begin {RotateChar}
  603.  
  604.    with CharEnt do
  605.       begin
  606.       NCI:=CWidth;
  607.       NBW:=(NCI+7) shr 3;
  608.       NRI:=CHeight;
  609.  
  610.       COff:=0;
  611.       for CR:=0 to NRI-1 do
  612.          begin
  613.          Move(CharPtr^[COff],ChBits[CR,0],NBW);
  614.          COff:=COff+NBW;
  615.          end;
  616.  
  617.     { for cr:=0 to nri-1 do
  618.          begin
  619.          for cc:=0 to nbw-1 do
  620.             for bc:=0 to 7 do
  621.                if (chbits[cr,cc] and masks[bc])<>0 then
  622.                   write(lst,'X')
  623.                else
  624.                   write(lst,'.');
  625.          writeln(lst);
  626.          end;
  627.       write(lst,^L);
  628.     }
  629.  
  630.       NCO:=NRI;
  631.       NBWO:=(NCO+7)shr 3;
  632.       NRO:=NCI;
  633.  
  634.       for CR:=0 to NRO-1 do
  635.          FillChar(LChBits[CR,0],NBWO,0);
  636.  
  637.     { for EC:=0 to NBW-1 do
  638.          begin
  639.          CR:=0;
  640.          CC:=EC div 8;
  641.          BC:=EC mod 8;
  642.  
  643.          for ER:=0 to NRI-1 do
  644.             begin
  645.             Byt:=ChBits[ER,EC];
  646.             for CRB:=0 to 7 do
  647.                begin
  648.                if (Byt and Masks[CRB])<>0 then
  649.                   LChBits[CR,CC]:=LChBits[CR,CC] or Masks[BC];
  650.                CR:=CR+1;
  651.                end;
  652.             end;
  653.          end;
  654.       }
  655.  
  656.       for EC:=0 to NCI-1 do
  657.          begin
  658.          CC:=EC shr 3;
  659.          BC:=EC and 7;
  660.          for ER:=0 to NRI-1 do
  661.             if (ChBits[ER,CC] and Masks[BC])<>0 then
  662.                LChBits[NCI-EC-1,ER shr 3]:=
  663.                   LChBits[NCI-EC-1,ER shr 3] or Masks[ER and 7];
  664.          end;
  665.  
  666.     { for cr:=0 to nro-1 do
  667.          begin
  668.          for cc:=0 to nbwo-1 do
  669.             for bc:=0 to 7 do
  670.                if (lchbits[cr,cc] and masks[bc])<>0 then
  671.                   write(lst,'X')
  672.                else
  673.                   write(lst,'.');
  674.          writeln(lst);
  675.          end;
  676.       write(lst,^L);
  677.     }
  678.  
  679.       Orient:=1;
  680.       COff:=NCI+LeftOffset-1;
  681.       LeftOffset:= -TopOffset;
  682.       TopOffset:=COff;
  683.       CWidth:=NCO;
  684.       CHeight:=NRO;
  685.  
  686.       FreeMem(CharPtr,CharLen);
  687.       CharLen:=NBWO*NRO;
  688.       GetMem(CharPtr,CharLen);
  689.  
  690.       COff:=0;
  691.       for CR:=0 to NRO-1 do
  692.          begin
  693.          Move(LChBits[CR,0],CharPtr^[COff],NBWO);
  694.          COff:=COff+NBWO;
  695.          end;
  696.  
  697.       end;
  698.  
  699.    end {RotateChar};
  700.  
  701. procedure RotateFont;
  702.  
  703.    var
  704.       Cn:         Byte;
  705.       MaxWidth:   Byte;
  706.       RowWidth:   Integer;
  707.       R:          Byte;
  708.       Iy:         Integer;
  709.       Ix:         Integer;
  710.  
  711.    begin {RotateFont}
  712.  
  713.    with Font^ do
  714.       begin
  715.       Orient:=1;
  716.  
  717.       for Cn:=0 to MaxChar do
  718.          if Chars[Cn].ChNbr<>0 then
  719.             begin
  720.             RotateChar(Chars[Cn]);
  721.             write(trm,^M^['K',Cn:1);
  722.             end;
  723.  
  724.       writeln(trm);
  725.       end;
  726.  
  727.    end {RotateFont};
  728.  
  729. begin
  730.  
  731. DefRegs.Ds:=DSeg;
  732. DefRegs.Es:=DSeg;
  733.  
  734. new(Font);
  735.  
  736. writeln(trm,^J^J^J);
  737.  
  738. ReadFont;
  739.  
  740. writeln(trm,'Rotating font.');
  741. RotateFont;
  742.  
  743. writeln(trm,'Writing new font.');
  744. WriteFont;
  745.  
  746. end.
  747.